home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / vb / scbar.exe / FILEPRC.BAS next >
Encoding:
BASIC Source File  |  1993-01-05  |  6.6 KB  |  190 lines
  1. Option Explicit
  2.  
  3. '**********************************************************
  4. '   1993 -  Gary Garrison
  5. '           Software Assist Corporation
  6. '**********************************************************
  7.  
  8. '**********************************************************
  9. '   File Control Structure.
  10. '**********************************************************
  11. Type File_Con
  12. Name            As String
  13. Nbr             As Integer
  14. sz              As Long
  15. c               As Long
  16. End Type
  17.  
  18. Global Const MAX_REC_LEN = 255
  19. Dim TXTFile     As File_Con
  20. Dim LastRecord  As String
  21. Dim Priorc      As Long
  22.  
  23. '**********************************************************
  24. '   Misc. flags, etc.
  25. '**********************************************************
  26. Global CRLF     As String
  27.  
  28. '**********************************************************
  29. '   Supporting Functions.
  30. '**********************************************************
  31. Declare Function LastOC Lib "filespt.dll" (ByVal pStr$, ByVal pChar$) As Long
  32. Declare Function SelectAFile Lib "filespt.dll" (ByVal hWnd%, ByVal dTitle$, ByVal szDefDir$, ByVal szInitFile$, ByVal szDefExt$, ByVal szFilter$) As String
  33. Declare Function Word Lib "filespt.dll" (ByVal pStr$, ByVal cWord%) As String
  34.  
  35. Function LocateARecord (ByVal c As Long) As String
  36.     Dim wpos As Integer
  37.  
  38. '**********************************************************
  39. '   If no file is open just exit.
  40. '**********************************************************
  41.     If TXTFile.Nbr = 0 Then Exit Function
  42.  
  43. '**********************************************************
  44. '   If they are asking to go beyond the end of the file,
  45. '   lie. Pretend we are just 1 character past the end.
  46. '**********************************************************
  47.     If c > TXTFile.sz Then c = TXTFile.sz + 1
  48.  
  49. '**********************************************************
  50. '   Read a record from the requested position.
  51. '**********************************************************
  52.     If c > 1 Then
  53.     c = c - MAX_REC_LEN
  54.     If c < 1 Then c = 1
  55.     LastRecord = Space$(MAX_REC_LEN)
  56.     Get TXTFile.Nbr, c, LastRecord
  57.  
  58. '**********************************************************
  59. '   Find the beginning of the last record in LastRecord
  60. '   and read it.
  61. '**********************************************************
  62.     wpos = LastOC(LastRecord, Chr$(10))
  63.     c = c + wpos
  64.     End If
  65.     LastRecord = Space$(MAX_REC_LEN)
  66.     Priorc = c
  67.     Get TXTFile.Nbr, c, LastRecord
  68.  
  69. '**********************************************************
  70. '   Locate the CRLF at the end of the record.
  71. '**********************************************************
  72.     wpos = InStr(LastRecord, CRLF)
  73.     If wpos = 0 Then
  74.     TXTFile.c = c + Len(LastRecord)
  75.     LocateARecord = LastRecord
  76.     Else
  77.     TXTFile.c = c + wpos + 1
  78.     LocateARecord = Left$(LastRecord, wpos - 1)
  79.     LastRecord = Left$(LastRecord, wpos + 1)
  80.     End If
  81. End Function
  82.  
  83. Function NextFilePosition () As Long
  84. '**********************************************************
  85. '   Return the next position that would be read in the
  86. '   file.
  87. '**********************************************************
  88.     NextFilePosition = TXTFile.c
  89. End Function
  90.  
  91. Function OpenAFile () As Long
  92. '**********************************************************
  93. '   Open a file and fill in the File_Con structure for it.
  94. '**********************************************************
  95.  
  96.     Dim wName As String
  97.  
  98.     OpenAFile = 0
  99.     CRLF = Chr$(13) + Chr$(10)
  100.  
  101. '**********************************************************
  102. '   Select the file to browse.
  103. '**********************************************************
  104.     wName = Word(SelectAFile(frmMain.hWnd, "Open a File", CurDir$, "*.*", "TXT", "All Files(*.*)|*.*|"), 1)
  105.     If wName = "" Then Exit Function
  106.  
  107. '**********************************************************
  108. '   Open up the file and get other info on it.
  109. '**********************************************************
  110.     If TXTFile.Nbr <> 0 Then Close TXTFile.Nbr
  111.     TXTFile.Name = wName
  112.     TXTFile.Nbr = FreeFile
  113.     Open TXTFile.Name For Binary Access Read Lock Write As TXTFile.Nbr
  114.     TXTFile.c = 1
  115.     TXTFile.sz = LOF(TXTFile.Nbr)
  116.     OpenAFile = TXTFile.sz
  117. End Function
  118.  
  119. Function ReadNextRecord () As String
  120. '**********************************************************
  121. '   Return the next record in the file.
  122. '**********************************************************
  123.  
  124.     Dim wpos As Integer
  125.  
  126. '**********************************************************
  127. '   If no file is open or we are at EOF, just exit.
  128. '**********************************************************
  129.     If TXTFile.Nbr = 0 Then Exit Function
  130.     If TXTFile.c > TXTFile.sz Then Exit Function
  131.  
  132. '**********************************************************
  133. '   Read in the next record.
  134. '**********************************************************
  135.     LastRecord = Space$(MAX_REC_LEN)
  136.     Get TXTFile.Nbr, TXTFile.c, LastRecord
  137.  
  138. '**********************************************************
  139. '   Locate the CRLF at the end of the record.
  140. '**********************************************************
  141.     Priorc = TXTFile.c
  142.     wpos = InStr(LastRecord, CRLF)
  143.     If wpos = 0 Then
  144.     TXTFile.c = TXTFile.c + Len(LastRecord)
  145.     ReadNextRecord = LastRecord
  146.     Else
  147.     TXTFile.c = TXTFile.c + wpos + 1
  148.     ReadNextRecord = Left$(LastRecord, wpos - 1)
  149.     LastRecord = Left$(LastRecord, wpos + 1)
  150.     End If
  151. End Function
  152.  
  153. Function ReadPriorRecord () As String
  154. '**********************************************************
  155. '   Return the prior record in the file.
  156. '**********************************************************
  157.  
  158.     Dim wrec As String
  159.     Dim wc As Long
  160.     Dim wpos As Integer
  161.  
  162. '**********************************************************
  163. '   If no file is open or we are at BOF, just exit.
  164. '**********************************************************
  165.     If TXTFile.Nbr = 0 Then Exit Function
  166.     If Priorc = 1 Then TXTFile.c = 1
  167.     If TXTFile.c = 1 Then Exit Function
  168.  
  169. '**********************************************************
  170. '   Read in the prior record.
  171. '**********************************************************
  172.     wc = Priorc - MAX_REC_LEN
  173.     If wc < 1 Then wc = 1
  174.     LastRecord = Space$(Priorc - 2 - wc)
  175.     Get TXTFile.Nbr, wc, LastRecord
  176.  
  177. '**********************************************************
  178. '   Find the end of the prior record.
  179. '**********************************************************
  180.     wpos = LastOC(LastRecord, Chr$(10))
  181.     If wpos > 0 Then
  182.     LastRecord = Mid$(LastRecord, wpos + 1)
  183.     wc = wc + wpos
  184.     End If
  185.     ReadPriorRecord = LastRecord
  186.     Priorc = wc
  187.     TXTFile.c = wc + Len(LastRecord) + 2
  188. End Function
  189.  
  190.